home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / DELPHI32 / DIALOGS / BRWSFLDR / BROWSEFO.PAS < prev    next >
Pascal/Delphi Source File  |  1996-09-28  |  21KB  |  492 lines
  1. //--------------------------------------------------------------------------------------------------------//
  2. //    TBrowseFolder Component
  3. //    Written by Todd Fast
  4. //    Copyright (C) 1996 by Pencilneck Software.  All rights reserved.
  5. //    Version 1.0, lego 9-25-96
  6. //
  7. //
  8. //    Description:
  9. //
  10. //        Native Delphi component that encapsulates the SHBrowseForFolder interface, which allows
  11. //        Win32 users to select a directory using the standard Explorer-like treeview dialog.
  12. //
  13. //
  14. //    Contact:
  15. //
  16. //        tfast@eden.com
  17. //        pencilneck@hotmail.com
  18. //
  19. //
  20. //    Distribution:
  21. //
  22. //        This component is freeware.  As such, Pencilneck Software gives no warranty    to its accuracy,
  23. //        fitness for any particular use, effects of use, or reliability.  This    component may not be
  24. //        distributed as a part of another component package without Pencilneck    Software's written
  25. //        consent.  It may be freely distributed, although it must be distributed with all original
  26. //        files in their original format intact.  If you use this component in your software, please
  27. //        include an acknowledgment that portions are copyrighted by Pencilneck Software.  Please
  28. //        contact the author, Todd Fast, at one of the above addresses with questions, comments,
  29. //        bug-reports or any updates you make to the component.
  30. //
  31. //
  32. //    Properties:
  33. //
  34. //        CallbackParam:
  35. //            App-specific value passed to the callback function from the browse dialog.
  36. //        Flags:
  37. //            Set of flags for determining what the browse dialog will allow the user to choose.
  38. //            Enforces these restrictions by enabling or disabling the OK button when a user
  39. //            chooses a particular type of file item.
  40. //        Folder:
  41. //            The top-level folder displayed in the browse dialog.  foDesktop is the default
  42. //            and is what users are used to seeing in Explorer.
  43. //        ShowFullPath:
  44. //            Enables or disables a custom feature that shows the selected path in the status area
  45. //            of the browse dialog.  Must have the bfStatusText flag set.
  46. //        Title:
  47. //            The title text shown in the browse dialog.
  48. //        DisplayName:
  49. //            Read-only.  The display name returned from the dialog in the BROWSEINFO structure;
  50. //        ImageIndex:
  51. //            Read-only.  The selected item's image index in the system image list.  Returned in
  52. //            the BROWSEINFO structure.
  53. //        Directory:
  54. //            Read-only.  The path of the chosen directory.
  55. //        BrowseDialogShowing:
  56. //            Read-only.  Set to TRUE when the browse dialog is already showing.
  57. //
  58. //
  59. //    Methods:
  60. //
  61. //        constructor Create(AOwner: TComponent);
  62. //            Standard constructor for TComponent.
  63. //
  64. //        function Execute: Boolean;
  65. //            Shows the browse dialog and allows the user to choose a directory.  Returns true if
  66. //            the user chose the OK button, FALSE if he or she chose the Cancel button.
  67. //
  68. //        procedure SetStatusText(const Hwnd: HWND; const StatusText: String);
  69. //            Hwnd:
  70. //                Handle of the browse dialog.
  71. //            StatusText:
  72. //                The text message.
  73. //            Sets the status area text to the text message.  You must have the bfStatusText flag
  74. //            set to see the status text.
  75. //
  76. //        procedure SetSelectionPIDL(const Hwnd: HWND; const ItemIDList: PItemIDList);
  77. //            Hwnd:
  78. //                Handle of the browse dialog.
  79. //            ItemIDList:
  80. //                Pointer to an item identifier list, also know as a 'pidl', which identifies a folder.
  81. //            Sets the selection in the browse dialog to the folder represented by the pidl.  The
  82. //            pidl is an opaque binary value and would need to be created by some other Shell API
  83. //            like SHGetSpecialFolderLocation.  Don't forget to deallocate and pidl you obtain
  84. //            yourself with the CoTaskMemFree function or equivalent.  Not generally as useful as
  85. //            the next method.
  86. //
  87. //        procedure SetSelectionPath(const Hwnd: HWND; const Path: String);
  88. //            Hwnd:
  89. //                Handle of the browse dialog.
  90. //            Path:
  91. //                String value of the path to select.
  92. //            Sets the selection in the browse dialog to the folder in the Path parameter.  The
  93. //            path can be in long or 8.3 format.
  94. //
  95. //    procedure EnableOK(const Hwnd: HWND; const Value: Boolean);
  96. //            Hwnd:
  97. //                Handle of the browse dialog.
  98. //            Value:
  99. //                Desired state of the browse dialog OK button.
  100. //            Sets the enabled state of the OK button in the browse dialog.  Note:  You can use this
  101. //            to override the restrictions set in the Flags property, but if the user selects an item
  102. //            that the Flags item restricts, the returned directory will be an empty string.
  103. //
  104. //
  105. //    Events:
  106. //
  107. //        OnInitialized(Hwnd: HWND; CallbackParam: LPARAM)
  108. //            Hwnd:
  109. //                Handle of the browse dialog.
  110. //            CallbackParam:
  111. //                Value of the CallbackParam property of the TBrowseFolder object whose Execute procedure
  112. //                was called.
  113. //            Fired when the browse dialog is done initializing.
  114. //
  115. //        OnSelectionChanged(Hwnd: HWND; CallbackParam: LPARAM; const ItemIDList: PItemIDList)
  116. //            Hwnd:
  117. //                Handle of the browse dialog.
  118. //            CallbackParam:
  119. //                Value of the CallbackParam property of the TBrowseFolder object whose Execute procedure
  120. //                was called.
  121. //            ItemPidl:
  122. //                Pidl of the selected item.  See the note below for info on getting the directory path
  123. //                from the pidl.
  124. //            Fired when a new folder in the browse dialog is selected.
  125. //
  126. //
  127. //    Comments:
  128. //
  129. //        This component wraps a few of the Win32 shell functions to display the Windows standard
  130. //        folder browse dialog.  Frankly, I hacked this component together over the course of a
  131. //        couple of evenings based on Microsoft's sketchy documentation and some of their C header
  132. //        files, so I can't vouch for the complete accuracy of the component.  It does seem to work
  133. //        quite well, though, and I haven't experienced any problems with it, so I tend to think
  134. //        everything works smoothly.  I also added to the basic functionality of showing the browse
  135. //        dialog the capability to show only particular directories, based on the handy
  136. //        SHGetSpecialFolderLocation function.  Some of the folder locations might not be defined
  137. //        on your system, so you may want to only use the common folders like foDesktop or foNetwork
  138. //        in your software.  If anyone has some comments on how I implemented the component
  139. //        (or simply knows better), please email me and correct any errors I've made.  Please forgive
  140. //        me for documenting the component in the source file instead of generating a help file;
  141. //        I've tried to make up for it by extensively commenting the code.
  142. //
  143. //
  144. //    Hints:
  145. //
  146. //    -    If you want to get the selected directory path in the OnSelectionChanged event, use the
  147. //        SHGetPathFromIDList function on the ItemPidl parameter passed into the event handler.
  148. //    -    The SetStatusText, SetSelectionPIDL, SetSelectionPath, and EnableOK methods ecapsulate
  149. //        the messages you can send to the browse dialog while it is active.  Use these functions
  150. //        from within the TBrowseFolder event handlers to make changes to the browse dialog instead
  151. //        of using SendMessage (although that would be perfectly acceptable, and this file defines
  152. //        all the constants you would need.)
  153. //    -    Use the SHGetFileInfo function to retrieve extended information about the selected folder.
  154. //    -    For more information, lookup SHBrowseForFolder, BROWSEINFO, and BrowseCallbackProc in the
  155. //        Win32 online help.
  156. //    -    Beware!  The Microsoft documentation on these functions shipped with Delphi is not entirely
  157. //        accurate.  In most cases, they've reversed the location of certain parameters sent to the
  158. //        callback function or of messages you can send to the browse dialog.  Compare my implementation
  159. //        below with the documentation for more information.
  160. //
  161. //--------------------------------------------------------------------------------------------------------//
  162.  
  163. unit BrowseFolder;
  164.  
  165. interface
  166.  
  167. uses
  168.   Windows, Messages, Classes, Forms, Dialogs, SysUtils, Ole2, Shlobj;
  169.  
  170. type
  171.     {Browser notification events}
  172.   TBrowserInitializedEvent=procedure(Hwnd: HWND; CallbackParam: LPARAM) of object;
  173.   TSelectionChangedEvent=procedure(Hwnd: HWND; CallbackParam: LPARAM; const ItemIDList: PItemIDList) of object;
  174.  
  175.     TBrowseInfoFlags=(bfFileSysDirsOnly,bfDontGoBelowDomain,bfStatusText,bfFileSysAncestors,bfBrowseForComputer,bfBrowseForPrinter);
  176.   TBrowseInfoFlagSet=set of TBrowseInfoFlags;
  177.  
  178.     TSHFolders=(foDesktop,foPrograms,foControls,foPrinters,foPersonal,foFavorites,foStartup,foRecent,
  179.         foSendto,foRecycleBin,foStartMenu,foDesktopDirectory,foMyComputer,foNetwork,foNetworkNeighborhood,
  180.         foFonts,foTemplates);
  181.  
  182. const
  183.     NUMBER_OF_BROWSE_INFO_FLAGS=6;
  184.     BROWSE_FLAG_ARRAY: array[TBrowseInfoFlags] of Integer=
  185.         (BIF_RETURNONLYFSDIRS,BIF_DONTGOBELOWDOMAIN,BIF_STATUSTEXT,BIF_RETURNFSANCESTORS,
  186.         BIF_BROWSEFORCOMPUTER,BIF_BROWSEFORPRINTER);
  187.  
  188.     SH_FOLDERS_ARRAY: array[TSHFolders] of Integer=
  189.         (CSIDL_DESKTOP,CSIDL_PROGRAMS,CSIDL_CONTROLS,CSIDL_PRINTERS,CSIDL_PERSONAL,CSIDL_FAVORITES,
  190.         CSIDL_STARTUP,CSIDL_RECENT,CSIDL_SENDTO,CSIDL_BITBUCKET,CSIDL_STARTMENU,CSIDL_DESKTOPDIRECTORY,
  191.         CSIDL_DRIVES,CSIDL_NETWORK,CSIDL_NETHOOD,CSIDL_FONTS,CSIDL_TEMPLATES);
  192.  
  193. type
  194.     EBrowseDialogAlreadyShowing=class(Exception);
  195.  
  196.     {TBrowseFolder}
  197.   TBrowseFolder = class(TComponent)
  198.   private
  199.         FBrowseDialogShowing: Boolean;
  200.         FTitle: String;
  201.         FCallbackParam: LPARAM;
  202.         FDisplayName: String;
  203.         FImageIndex: Integer;
  204.         FDirectory: String;
  205.         FFlags: TBrowseInfoFlagSet;
  206.         FShowPathInStatusArea: Boolean;
  207.         FFolder: TSHFolders;
  208.         FOnInitialized: TBrowserInitializedEvent;
  209.         FOnSelectionChanged: TSelectionChangedEvent;
  210.   protected
  211.   public
  212.         constructor Create(AOwner: TComponent); override;
  213.         function Execute: Boolean;
  214.         procedure SetStatusText(const Hwnd: HWND; const StatusText: String);
  215.         procedure SetSelectionPIDL(const Hwnd: HWND; const ItemIDList: PItemIDList);
  216.         procedure SetSelectionPath(const Hwnd: HWND; const Path: String);
  217.     procedure EnableOK(const Hwnd: HWND; const Value: Boolean);
  218.         property DisplayName: String read FDisplayName;
  219.         property ImageIndex: Integer read FImageIndex;
  220.         property Directory: String read FDirectory;
  221.         property BrowseDialogShowing: Boolean read FBrowseDialogShowing;
  222.   published
  223.         property Title: String read FTitle write FTitle;
  224.         property CallbackParam: LPARAM read FCallbackParam write FCallbackParam;
  225.         property Flags: TBrowseInfoFlagSet read FFlags write FFlags;
  226.         property ShowFullPath: Boolean read FShowPathInStatusArea write FShowPathInStatusArea;
  227.         property Folder: TSHFolders read FFolder write FFolder default foDesktop;
  228.         property OnInitialized: TBrowserInitializedEvent read FOnInitialized write FOnInitialized;
  229.         property OnSelectionChanged: TSelectionChangedEvent read FOnSelectionChanged write FOnSelectionChanged;
  230.   end;
  231.  
  232. {Utility functions}
  233. function CompressString(const Path, Separator, Replacement: String; MaxLength: Integer): String;
  234. function BreakApart(const theString, Separator: String; var Tokens: TStringList): Integer;
  235.  
  236. {Callback procedure; must be declared with stdcall since Windows will be calling it}
  237. procedure BrowserCallbackProc(hwnd: HWND; uMsg: Integer; lParam: LPARAM; lpData: LPARAM); stdcall;
  238. {Note: The following function is alluded to in the Shlobj.pas file, but no record of it exists.
  239. Instead, I use the CoTaskMemFree call to free any pidl's.  From what I can tell, this should be
  240. an equivalent call, since the Windows docs say that some of the task allocator API's are just
  241. quick calls to the OLE2 functions.  This should be one of them.}
  242. //function SHFree(ItemIDList: PItemIDList): HRESULT; external 'SHELL32.dll' name 'SHFree';
  243.  
  244. procedure Register;
  245.  
  246. implementation
  247.  
  248. var
  249.     {Global method pointers needed because callback function does not work properly when it's a member of an object.
  250.     This is an unorthodox implementation requiring some kludgy global variables, but I couldn't get Windows to
  251.     call back a method pointer properly because there's no way to declare a method pointer as stdcall.  If
  252.     anyone can come up with a solution, please mail me an updated copy.}
  253.     GlobalOnInitialized: TBrowserInitializedEvent;
  254.     GlobalOnSelectionChanged: TSelectionChangedEvent;
  255.     GlobalShowPathInStatusArea: Boolean;
  256.     GlobalBrowseDialogShowing: Boolean;
  257.  
  258. //--------------------------------------------------------------------------------------------------------//
  259. procedure Register;
  260. begin
  261.   RegisterComponents('Win95', [TBrowseFolder]);
  262. end;
  263.  
  264. //--------------------------------------------------------------------------------------------------------//
  265. {Compresses a string by replacing one or more components with the replacement string}
  266. function CompressString(const Path, Separator, Replacement: String; MaxLength: Integer): String;
  267. var
  268.     Tokens: TStringList;
  269.  
  270.     function BuildPath(const Components: TStringList): String;
  271.     var
  272.         i: Integer;
  273.     begin
  274.         for i:=0 to Components.Count-1 do
  275.             if i=0 then
  276.                 Result:=Components[i]
  277.             else
  278.                 Result:=Result+Separator+Components[i];
  279.     end;
  280.  
  281. begin
  282.     try
  283.         Tokens:=TStringList.Create;
  284.  
  285.         {Check if full path is less than MaxLength}
  286.         Result:=Path;
  287.         if StrLen(PChar(Result))<=MaxLength then
  288.             Exit;
  289.  
  290.         {Check if can replace the 2nd token with the replacement and make length less than MaxLength}
  291.         if BreakApart(Result,Separator,Tokens)<3 then
  292.             Exit
  293.         else
  294.             begin
  295.                 Tokens[1]:=Replacement;
  296.                 Result:=BuildPath(Tokens);
  297.             end;
  298.  
  299.         {Must continue to delete components until can get the length below the maximum}
  300.         while (StrLen(PChar(Result))>MaxLength) and (Tokens.Count>3) do
  301.             begin
  302.                 Tokens.Delete(2);
  303.                 Result:=BuildPath(Tokens);
  304.             end;
  305.     finally
  306.         Tokens.Free;
  307.     end;
  308. end;
  309.  
  310. //--------------------------------------------------------------------------------------------------------//
  311. {Breaks a string into tokens and places the tokens in a string list}
  312. function BreakApart(const theString, Separator: String; var Tokens: TStringList): Integer;
  313. var
  314.   Index: Integer;
  315.     CurrentString: String;
  316.     CurrentToken: String;
  317.     Done: Boolean;
  318. begin
  319.     Result:=0;
  320.     CurrentString:=theString;
  321.     Done:=FALSE;
  322.     Tokens.Clear;
  323.  
  324.     repeat
  325.         {Find the first separator in the string}
  326.         Index:=Pos(Separator,CurrentString);
  327.  
  328.          {If separator not found, we are done}
  329.         if Index=0 then
  330.             begin
  331.                 {Last token is whatever string is left}
  332.                 CurrentToken:=CurrentString;
  333.         Done:=TRUE;
  334.           end
  335.         else
  336.             begin
  337.                 {Get token and chop off the beginning}
  338.                 CurrentToken:=Copy(CurrentString,1,Index-1);
  339.                 CurrentString:=Copy(CurrentString,Index+1,Length(CurrentString)-Index);
  340.       end;
  341.  
  342.         {Add the token to the string list}
  343.         Tokens.Add(CurrentToken);
  344.         Inc(Result);
  345.  
  346.   until Done;
  347. end;
  348.  
  349. //--------------------------------------------------------------------------------------------------------//
  350. {Callback procedure; Windows calls this procedure upon certain events in the browse dialog.  This fucntion
  351. calls any defined event handlers for the current global event pointers.}
  352. procedure BrowserCallbackProc(hwnd: HWND; uMsg: Integer; lParam: LPARAM; lpData: LPARAM);
  353. var
  354.     Path: String;
  355. begin
  356.     case uMsg of
  357.         BFFM_INITIALIZED:
  358.             if Assigned(GlobalOnInitialized) then
  359.                 GlobalOnInitialized(hwnd,lParam);
  360.  
  361.         BFFM_SELCHANGED:
  362.             begin
  363.                 if Assigned(GlobalOnSelectionChanged) then
  364.                     GlobalOnSelectionChanged(hwnd,lpData,PItemIDList(lParam));
  365.  
  366.                 if GlobalShowPathInStatusArea then
  367.                     begin
  368.                         SetLength(Path,MAX_PATH);
  369.                         SHGetPathFromIDList(PItemIDList(lParam),PChar(Path));
  370.                         Path:=CompressString(Path,'\','...',35);
  371.                         SendMessage(hwnd,BFFM_SETSTATUSTEXT,0,Longint(PChar(Path)));
  372.                     end;
  373.             end;
  374.     end;
  375. end;
  376.  
  377. {TBrowseFolder}
  378. //--------------------------------------------------------------------------------------------------------//
  379. constructor TBrowseFolder.Create(AOwner: TComponent);
  380. begin
  381.     inherited Create(AOwner);
  382.     SetLength(FDisplayName,MAX_PATH);
  383.     SetLength(FDirectory,MAX_PATH);
  384. end;
  385.  
  386. //--------------------------------------------------------------------------------------------------------//
  387. {Use this function to set the status text of the browse dialog from within one of the TBrowseFolder event handlers}
  388. procedure TBrowseFolder.SetStatusText(const Hwnd: HWND; const StatusText: String);
  389. begin
  390.     SendMessage(Hwnd,BFFM_SETSTATUSTEXT,0,Longint(PChar(StatusText)));
  391. end;
  392.  
  393. //--------------------------------------------------------------------------------------------------------//
  394. {Use this function to set the selection of the browse dialog manually from within one of the TBrowseFolder event handlers}
  395. procedure TBrowseFolder.SetSelectionPIDL(const Hwnd: HWND; const ItemIDList: PItemIDList);
  396. begin
  397.     SendMessage(Hwnd,BFFM_SETSELECTION,Ord(FALSE),Longint(ItemIDList));
  398. end;
  399.  
  400. //--------------------------------------------------------------------------------------------------------//
  401. {Use this function to set the selection of the browse dialog manually from within one of the TBrowseFolder event handlers}
  402. procedure TBrowseFolder.SetSelectionPath(const Hwnd: HWND; const Path: String);
  403. begin
  404.     SendMessage(Hwnd,BFFM_SETSELECTION,Ord(TRUE),Longint(PChar(Path)));
  405. end;
  406.  
  407. //--------------------------------------------------------------------------------------------------------//
  408. {Use this function to enable/disable the OK button of the browse dialog from within one of the TBrowseFolder event handlers}
  409. procedure TBrowseFolder.EnableOK(const Hwnd: HWND; const Value: Boolean);
  410. begin
  411.     SendMessage(Hwnd,BFFM_ENABLEOK,0,Ord(Value));
  412. end;
  413.  
  414. //--------------------------------------------------------------------------------------------------------//
  415. {Use this function to show the browse dialog.  While a browse dialog is showing, the program cannot show
  416. another.  If for some reason you try to show another dialog while one is already showing, this function
  417. returns an EBrowseDialogAlreadyShowing exception.  This shouldn't be a problem unless you try to show the
  418. dialog from several independant threads}
  419. function TBrowseFolder.Execute: Boolean;
  420. var
  421.     BrowseInfo: TBrowseInfo;
  422.     ItemIDList: PItemIDList;        //Pointer to a file ID list
  423.     TempOnInitialized: TBrowserInitializedEvent;
  424.     TempOnSelectionChanged: TSelectionChangedEvent;
  425.     TempShowPathInStatusArea: Boolean;
  426.     i: Integer;
  427.     TempPath: array[0..MAX_PATH] of Char; //To avoid some odd problems I've encountered casting strings as PChar's
  428. begin
  429.     {Check for an already-showing dialog}
  430.     if FBrowseDialogShowing then
  431.         raise EBrowseDialogAlreadyShowing.Create('The browse dialog is already showing.');
  432.  
  433.     try
  434.         {Block similar calls to this function while a browse dialog is already displayed}
  435.         GlobalBrowseDialogShowing:=TRUE;
  436.  
  437.         {Save the global callback method pointers (which are shared by all instances of TBrowseFolder}
  438.         TempOnInitialized:=GlobalOnInitialized;
  439.         TempOnSelectionChanged:=GlobalOnSelectionChanged;
  440.         TempShowPathInStatusArea:=GlobalShowPathInStatusArea;
  441.  
  442.         {Init the BrowseInfo structure}
  443.         BrowseInfo.hwndOwner:=Application.Handle;
  444.  
  445.         {Get the pointer to the appropriate folder pidl}
  446.         SHGetSpecialFolderLocation(Application.Handle,SH_FOLDERS_ARRAY[FFolder],BrowseInfo.pidlRoot);
  447.  
  448.         BrowseInfo.pszDisplayName:=PChar(FDisplayName);
  449.         BrowseInfo.lpszTitle:=PChar(FTitle);
  450.  
  451.         {OR all the flags together}
  452.         BrowseInfo.ulFlags:=0;
  453.         for i:=0 to NUMBER_OF_BROWSE_INFO_FLAGS-1 do
  454.             if TBrowseInfoFlags(i) in FFlags then
  455.                 BrowseInfo.ulFlags:=BrowseInfo.ulFlags or BROWSE_FLAG_ARRAY[TBrowseInfoFlags(i)];
  456.  
  457.         {Change the global pointers to point to this object's handlers so the non-member callback function can access them}
  458.         GlobalOnInitialized:=FOnInitialized;
  459.         GlobalOnSelectionChanged:=FOnSelectionChanged;
  460.         GlobalShowPathInStatusArea:=FShowPathInStatusArea;
  461.  
  462.         BrowseInfo.lpfn:=@BrowserCallbackProc;
  463.         BrowseInfo.lParam:=FCallbackParam;
  464.         BrowseInfo.iImage:=0;
  465.  
  466.         {Show the dialog}
  467.         FBrowseDialogShowing:=TRUE;
  468.         ItemIDList:=SHBrowseForFolder(BrowseInfo);
  469.         Result:=ItemIDList<>nil;
  470.         if Result then
  471.             begin
  472.                 //SHGetPathFromIDList(ItemIDList,PChar(FDirectory));
  473.                 SHGetPathFromIDList(ItemIDList,TempPath);
  474.                 FDirectory:=StrPas(TempPath);
  475.                 FImageIndex:=BrowseInfo.iImage;
  476.             end;
  477.  
  478.     finally
  479.         {Free the ID lists with the system task allocator}
  480.         CoTaskMemFree(ItemIDList);
  481.         CoTaskMemFree(BrowseInfo.pidlRoot);
  482.         FBrowseDialogShowing:=FALSE;
  483.  
  484.         {Restore the global pointers}
  485.         GlobalOnInitialized:=TempOnInitialized;
  486.         GlobalOnSelectionChanged:=TempOnSelectionChanged;
  487.         GlobalShowPathInStatusArea:=TempShowPathInStatusArea;
  488.     end;
  489. end;
  490.  
  491. end.
  492.